home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / u_heap.zip / SHOWHEAP.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-14  |  1KB  |  57 lines
  1.  
  2. Unit ShowHeap;
  3.  
  4. interface
  5.  
  6. uses
  7.   CRT,UMB_Heap;
  8.  
  9.   Procedure Show_Heap;
  10.  
  11. implementation
  12.  
  13. type
  14.   PFreeRec = ^TFreeRec;      {  From pg. 216 of the TP6 programmer's guide.  }
  15.   TFreeRec = record          {  It's used for traversing the free blocks of  }
  16.     Next : PFreeRec;         {  the heap.                                    }
  17.     Size : Pointer;
  18.   end;
  19.  
  20. Function Pointer_To_LongInt(P : Pointer) : LongInt;
  21.   type
  22.     PtrRec = record
  23.       Lo,Hi : Word;
  24.     end;
  25.   Begin
  26.     Pointer_To_LongInt := LongInt(PtrRec(P).Hi)*16+PtrRec(P).Lo;
  27.   End;
  28.  
  29. Procedure Show_Heap;
  30.   var
  31.     N : Word;
  32.     BlockSize,Total : LongInt;
  33.     Temp : PFreeRec;
  34.   Begin
  35.     N := 1;
  36.     Total := 0;
  37.     if (FreeList <> HeapPtr) then
  38.       begin
  39.         Temp := FreeList;
  40.         repeat
  41.           BlockSize := Pointer_To_LongInt(Temp^.Size);
  42.           Total := Total+BlockSize;
  43.           WriteLn('   Block ',N,' contains  ',BlockSize:6,' bytes');
  44.           Inc(N);
  45.           Temp := Temp^.Next;
  46.         until (Temp = HeapPtr);
  47.       end;
  48.     BlockSize := Pointer_to_LongInt(HeapEnd)-Pointer_to_LongInt(HeapPtr);
  49.     WriteLn('   Block ',N,' contains  ',BlockSize:6,' bytes');
  50.     Total := Total+BlockSize;
  51.     WriteLn('   -------------------------------');
  52.     WriteLn('   Total heap size = ',Total:6,' bytes');
  53.     WriteLn;
  54.   End;
  55.  
  56. BEGIN
  57. END.